home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / TCP-based EVAL server / eval-client.lisp next >
Encoding:
Text File  |  1994-09-12  |  2.0 KB  |  65 lines  |  [TEXT/CCL2]
  1. ;eval-client
  2. (require :mactcp)
  3.  
  4. (defparameter *port-for-eval-server* 5555)
  5. (defparameter *eval-server-client-plist* nil)
  6.  
  7. (defun request-eval-open-stream (client-stream string)
  8.   (ccl::telnet-write-line client-stream string)
  9.   (values (ccl::telnet-read-line client-stream))
  10.   )
  11.  
  12. (defun start-eval-client (server-string client-name)
  13.   (let ((client-stream 
  14.          (ignore-errors (open-tcp-stream server-string *port-for-eval-server*))))
  15.     (cond (client-stream
  16.            (setf (getf *eval-server-client-plist* client-name) client-stream)
  17.            (values client-stream :ok))
  18.           (t (values nil :server-open-failed)))))
  19.  
  20. (defun stop-eval-client (client-name)
  21.   (close (getf *eval-server-client-plist* client-name))
  22.   (remf  *eval-server-client-plist* client-name)
  23.   )
  24.  
  25. (defun request-eval (s-expression client-name)
  26.   (let ((stream (getf *eval-server-client-plist* client-name)))
  27.     (cond ((null stream)
  28.            (values nil :server-not-found))
  29.           ;stream found
  30.           ((eql :ESTABLISHED (ccl::tcp-state-name (ccl::tcp-connection-state stream)))
  31.            (values
  32.             (read-from-string
  33.              (request-eval-open-stream 
  34.               stream
  35.               (format nil "~S" s-expression)))
  36.             :ok))
  37.           (T (values nil :server-in-bad-state)))))
  38.  
  39. (defun stop-all-eval-clients ()
  40.   (let ((servers nil))
  41.     (do ((s *eval-server-client-plist* (cddr s)))
  42.         ((endp s))
  43.       (push (first s) servers))
  44.     (dolist (s servers)
  45.       (stop-eval-client s)))
  46.   )
  47.  
  48. #|
  49. (start-eval-client "132.187.103.165" :the-first-client)
  50. (start-eval-client "132.187.103.165" :the-second-client)
  51.  
  52. (request-eval  '(+ 3 4 5) :the-first-client)
  53.  
  54. (request-eval  '(progn
  55.                   (defun fakul (n)
  56.                     (if (<= n 1)
  57.                       1
  58.                       (* n (fakul (1- n)))))
  59.                   (fakul 10))
  60.                :the-second-client)
  61.  
  62. (request-eval  '(fakul 100) :the-second-client)
  63. (request-eval  '(faku1 100) :the-second-client)
  64. (stop-all-eval-clients)
  65. |#